home *** CD-ROM | disk | FTP | other *** search
/ Amiga Format CD 49 / Amiga Format CD49 (2000-01-17)(Future Publishing)(GB)(Track 1 of 3)[!][issue 2000-02].iso / -serious- / programming / arexx / cliped / cliped.rexx < prev   
OS/2 REXX Batch file  |  1999-11-29  |  13KB  |  478 lines
  1. /*
  2. ** $VER: cliped.rexx 1.12a (12.9.99) Rolf Max Rotvel
  3. */
  4.  
  5. rxlv.width = 300
  6. rxlv.height = 200
  7.  
  8. /*
  9. ** End cfg.
  10. */
  11. call addlib('rexxreqtools.library', 0, -30, 0)
  12. call addlib('rexxsupport.library', 0, -30, 0)
  13.  
  14. nl = '0a'x
  15. cr = '0d'x
  16. sep = '¤'
  17. oldclips = ''
  18. title = 'ClipEd'
  19.  
  20. defgads = '_Ok|_Cancel'
  21.  
  22. call rxlv_init()
  23. call get_clips()
  24.  
  25. do forever
  26.     num = rxlv_main(title'  ['numclips']  Press <HELP> for keys', 'dDeEqQrRnNuU')   
  27.     upkey = upper(rxlv.key)
  28.     select
  29.         when (upkey = 'D' | upkey = 'DEL') & num > 0 then call delete_clip(num)
  30.         when (upkey = 'Q' | upkey = 'ESC') then do
  31.             call rxlv_closewin()
  32.             exit
  33.         end
  34.         when upkey = 'E' & num > 0 then call edit_clip(num)
  35.         when upkey = 'N' then call create_clip()
  36.         when upkey = 'R' & num > 0 then call rename_clip(num)
  37.         when upkey = 'U' then call get_clips()
  38.         otherwise do       /* 'RET' */
  39.             if num > 0 then call view_clip(num)
  40.         end
  41.     end
  42. end
  43.  
  44.  
  45. GET_CLIPS:
  46. clips = show('c',, sep)
  47.  
  48. if clips ~= '' then do
  49.     clipnames = clips
  50.     c = 1
  51.     len = 0
  52.     do forever
  53.         parse var clipnames clip.name.c (sep) clipnames
  54.  
  55.         if clip.name.c = '' then leave  /* No more clips */
  56.  
  57.         clip.value.c = checklf(getclip(clip.name.c))    /* Check clips for lf/cr */
  58.         clips = clips||clip.value.c
  59.         
  60.         len = max(len, length(clip.name.c))
  61.         c = c + 1
  62.     end
  63.     numclips = c - 1
  64.  
  65.     do f = 1 to numclips
  66.         viewline.f = left(left(clip.name.f, len)' : 'clip.value.f, rxlv.dispcols)
  67.     end
  68. end
  69. else numclips = 0
  70.  
  71. if oldclips ~= clips then do
  72.     oldclips = clips
  73.     call rxlv_closewin()
  74. end
  75.  
  76. viewline.0 = numclips
  77. return
  78.  
  79.  
  80. VIEW_CLIP: 
  81. arg clipnum
  82.  
  83. body = 'Name  : 'clip.name.clipnum||nl'Value : 'clip.value.clipnum
  84. gads = '_Edit clip|_Delete clip|_Rename clip|_Cancel'
  85.  
  86. ans = rtezrequest(body, gads, title)
  87.  
  88. select
  89.     when ans = 0 then nop
  90.     when ans = 1 then call edit_clip(clipnum)
  91.     when ans = 2 then call delete_clip(clipnum)
  92.     when ans = 3 then call rename_clip(clipnum)
  93.     otherwise exit 10
  94. end
  95. return
  96.  
  97.  
  98. EDIT_CLIP: 
  99. arg clipnum
  100. body = 'Enter new value for 'clip.name.clipnum
  101.  
  102. ans = rtgetstring(clip.value.clipnum, body, title, defgads)
  103. if rtresult = 0 | ans = '' then return
  104.  
  105. if confirm('Use this value?', clip.name.clipnum, ans,,) then do
  106.     call setclip(clip.name.clipnum, addlf(ans))     /* Convert \nl \cr -> nl cr */
  107.     call get_clips()
  108. end                                
  109. return
  110.  
  111.  
  112. RENAME_CLIP: 
  113. arg clipnum
  114. body = 'Enter new name for 'clip.name.clipnum
  115.  
  116. ans = rtgetstring(clip.name.clipnum, body, title, defgads)
  117. if rtresult = 0 | ans = '' then return
  118.  
  119. do chk = 1 to numclips
  120.     if clip.name.chk = ans then do
  121.         if confirm('Clip already exists! Overwrite it?'||nl||'Name     : '||,
  122.                     ans, clip.value.chk, clip.value.clipnum, 'Old value: ', 'New value: ') then do
  123.             call setclip(clip.name.clipnum, '')
  124.             call setclip(ans, clip.value.clipnum)
  125.             call get_clips()
  126.         end
  127.         return
  128.     end
  129. end
  130.  
  131. if confirm('Rename clip?', clip.name.clipnum, ans, 'Old name: ', 'New name: ') then do
  132.     call setclip(clip.name.clipnum, '')
  133.     call setclip(ans, clip.value.clipnum)
  134.     call get_clips()
  135. end
  136. return
  137.  
  138.  
  139. DELETE_CLIP: 
  140. arg clipnum
  141.  
  142. if confirm('Delete this clip?', clip.name.clipnum, clip.value.clipnum) then do
  143.     call setclip(clip.name.clipnum, '')
  144.     call get_clips()
  145. end                                
  146. return
  147.  
  148.  
  149. CREATE_CLIP: 
  150. newname = rtgetstring(, 'Enter the name of the new clip', title, defgads)
  151. if rtresult = 0 | newname = '' then return
  152.  
  153. chkvalue = getclip(newname)
  154. if chkvalue ~= '' then do
  155.     do clipcount = 1 to numclips
  156.         if clip.name.clipcount = newname then leave
  157.     end
  158.     if confirm('Clip already exists! Change value?', clip.name.clipcount, clip.value.clipcount) then do
  159.         call edit_clip(clipcount)
  160.     end
  161. end
  162. else do
  163.     newvalue = rtgetstring(, 'Enter the value of the new clip', title, defgads)
  164.     if rtresult = 0 | newvalue = '' then return
  165.  
  166.     if confirm('Create this clip?', newname, newvalue) then do
  167.         call setclip(newname, addlf(newvalue))
  168.         call get_clips()
  169.     end
  170. end
  171. return
  172.  
  173.  
  174. CONFIRM: procedure expose title nl defgads
  175. parse arg txt, name, value, pre1, pre2
  176.  
  177. if pre1 = '' then pre1 = 'Name  : '
  178. if pre2 = '' then pre2 = 'Value : '
  179.  
  180. body = txt||nl||pre1||name||nl||pre2||value
  181.  
  182. if rtezrequest(body, defgads, title) then return 1
  183. return 0
  184.  
  185.  
  186. RXLV_HELP: procedure
  187. nl = '0a'x
  188. helptxt = ' Use Cursor/Shift Cursor to'nl,
  189.           'move and Enter to select.'nl,
  190.           '---------------------------'nl,
  191.           'd or Delete: Delete clip'nl,
  192.           'e: Edit clip value'nl,
  193.           'r: Rename clip'nl,
  194.           'n: Create a new clip'nl,
  195.           'u: Update the cliplist'nl,
  196.           'q or Escape: Quit ClipEd'                       
  197.  
  198. call rtezrequest(helptxt)
  199. return
  200.  
  201.  
  202. RXLV_MAIN: procedure expose viewline. rxlv.
  203. parse arg titletxt, inlinechars
  204.  
  205. /* Reset key */
  206. rxlv.key = ''
  207.  
  208. /* Which is bigger - win rows or lines in stemvar? */
  209. if rxlv.disprows > viewline.0 then rxlv.actrows = viewline.0
  210. else rxlv.actrows = rxlv.disprows
  211.  
  212. /* Get current mouse coordinates */
  213. if ~rxlv.opened? then do
  214.     call forbid()
  215.     mousex = c2d(import(offset(rxlv.screen, 18), 2)) - 50      /* Screen->MouseX */
  216.     mousey = c2d(import(offset(rxlv.screen, 16), 2)) - 50      /* Screen->MouseY */
  217.     call permit()
  218.  
  219.     /* Open the listview */
  220.     if ~open(rxlv.win, 'RAW:'mousex'/'mousey'/'rxlv.width'/'rxlv.height'/'titletxt'/NOSIZE', 'w') then do
  221.         say 'Could not open listview window!'
  222.         exit 10
  223.     end
  224.         
  225.     call writech(rxlv.win, rxlv.nocursor||rxlv.nowordwrap)
  226.     /* Initialize window */
  227.     if viewline.0 > 0 then do
  228.         rxlv.row = 1 
  229.         rxlv.var = 1
  230.         rxlv.topvar = 1 
  231.         call writech(rxlv.win, rxlv_getlighty(rxlv.row, rxlv.var)||rxlv.nl||rxlv_getpage(rxlv.var + 1))
  232.     end
  233.     rxlv.opened? = 1
  234. end
  235.  
  236. /* Do ze stuff */
  237. do forever
  238.     rxlv.oldrow = rxlv.row 
  239.     rxlv.oldvar = rxlv.var
  240.  
  241.     char = readch(rxlv.win, 1)
  242.     select
  243.         when char = rxlv.csi then do
  244.             char = readch(rxlv.win, 1)
  245.             select
  246.                 when viewline.0 < 2 then nop
  247.                 when char = rxlv.cursordown then do
  248.                     if rxlv.oldvar ~= viewline.0 then do
  249.                         line = rxlv_getunlighty()
  250.                         rxlv.var = rxlv.var + 1
  251.  
  252.                         if rxlv.oldrow < rxlv.actrows then rxlv.row = rxlv.row + 1 
  253.                         else do
  254.                             line = line||rxlv.nl
  255.                             rxlv.row = rxlv.actrows
  256.                             rxlv.topvar = rxlv.topvar + 1
  257.                         end
  258.                         call writech(rxlv.win, line||rxlv_getlighty())
  259.                     end
  260.                     else call rxlv_top()
  261.                 end  
  262.                 when char = rxlv.cursorup then do
  263.                     if rxlv.oldvar ~= 1 then do
  264.                         line = rxlv_getunlighty()
  265.                         rxlv.var = rxlv.var - 1
  266.  
  267.                         if rxlv.oldrow ~= 1 then do
  268.                             rxlv.row = rxlv.row - 1
  269.                             call writech(rxlv.win, line||rxlv_getlighty())
  270.                         end
  271.                         else do
  272.                             rxlv.row = 1 
  273.                             rxlv.topvar = rxlv.topvar - 1
  274.                             call writech(rxlv.win, line||rxlv_getlighty()||rxlv.nl||rxlv_getpage(rxlv.var + 1))
  275.                         end            
  276.                     end
  277.                     else call rxlv_bottom()                  
  278.                 end
  279.                 when char = rxlv.scursorup then do
  280.                     if rxlv.oldvar ~= 1 then do
  281.                         rxlv.row = 1
  282.                         rxlv.var = rxlv.topvar
  283.  
  284.                         if rxlv.oldrow = 1 then do
  285.                             if rxlv.oldvar - rxlv.actrows < 1 then rxlv.topvar = 1
  286.                             else rxlv.topvar = rxlv.oldvar - rxlv.actrows
  287.                             rxlv.var = rxlv.topvar
  288.                             call writech(rxlv.win, rxlv.cls||rxlv_getlighty()||rxlv.nl||rxlv_getpage(rxlv.topvar + 1))
  289.                         end
  290.                         else call writech(rxlv.win, rxlv_getunlighty()||rxlv_getlighty())
  291.                     end
  292.                     else call rxlv_bottom()                  
  293.                 end
  294.                 when char = rxlv.scursordown then do
  295.                     if rxlv.oldvar ~= viewline.0 then do
  296.                         rxlv.row = rxlv.actrows
  297.  
  298.                         if rxlv.oldrow = rxlv.actrows then do
  299.                             if rxlv.oldvar + rxlv.actrows > viewline.0 then rxlv.topvar = viewline.0 - (rxlv.actrows - 1)
  300.                             else rxlv.topvar = rxlv.oldvar + 1
  301.                             rxlv.var = min(viewline.0, rxlv.topvar + (rxlv.actrows - 1))
  302.                             call writech(rxlv.win, rxlv.cls||rxlv_getpage(rxlv.topvar)||rxlv.nl||rxlv_getlighty())
  303.                         end
  304.                         else do
  305.                             rxlv.var = (rxlv.topvar + rxlv.actrows) - 1
  306.                             call writech(rxlv.win, rxlv_getunlighty()||rxlv_getlighty())
  307.                         end
  308.                     end
  309.                     else call rxlv_top()
  310.                 end
  311.                 otherwise nop
  312.             end
  313.         end
  314.         when char = rxlv.esc then do
  315.             rxlv.key = 'ESC'
  316.             return rxlv_val()
  317.         end
  318.         when char = rxlv.cr then do
  319.             rxlv.key = 'RET'
  320.             return rxlv_val()
  321.         end
  322.         when char = rxlv.del then do
  323.             rxlv.key = 'DEL'
  324.             return rxlv_val()
  325.         end
  326.         when pos(char, inlinechars) > 0 then do
  327.             rxlv.key = char
  328.             return rxlv_val()
  329.         end
  330.         when char = rxlv.help then call rxlv_help()
  331.         otherwise nop
  332.     end
  333. end
  334.  
  335.  
  336. RXLV_VAL: procedure expose rxlv. viewline.
  337. if viewline.0 = 0 then return 0
  338. return rxlv.oldvar
  339.  
  340.  
  341. RXLV_TOP: procedure expose rxlv. viewline.
  342. rxlv.var = 1
  343. rxlv.row = 1
  344.  
  345. if rxlv.topvar = 1 then do   /* Just move to top */
  346.     line = rxlv_getunlighty()
  347.     call writech(rxlv.win, line||rxlv_getlighty())
  348. end
  349. else do
  350.     rxlv.topvar = 1
  351.     call writech(rxlv.win, rxlv.cls||rxlv_getlighty()||rxlv.nl||rxlv_getpage(rxlv.var + 1))
  352. end
  353. return
  354.  
  355.  
  356. RXLV_BOTTOM: procedure expose rxlv. viewline.
  357. rxlv.var = viewline.0
  358.  
  359. if viewline.0 <= rxlv.actrows then do 
  360.     line = rxlv_getunlighty()
  361.     rxlv.row = viewline.0
  362.     call writech(rxlv.win, line||rxlv_getlighty())
  363. end
  364. else do
  365.     rxlv.row = rxlv.actrows
  366.     rxlv.topvar = (viewline.0 - rxlv.actrows) + 1
  367.     call writech(rxlv.win, rxlv.cls||rxlv_getpage(rxlv.topvar)||rxlv.nl||rxlv_getlighty())
  368. end
  369. return
  370.  
  371.  
  372. RXLV_GETPAGE: procedure expose viewline. rxlv.
  373. if viewline.0 = 1 then return ''
  374.  
  375. top = arg(1)
  376. page = ''
  377. do y = 1 to rxlv.actrows - 2                    /* Lines between first and last */
  378.     page = page||viewline.top||rxlv.nl
  379.     top = top + 1
  380. end 
  381. page = page||viewline.top                       /* No newline after last line */
  382. return page
  383.  
  384.  
  385. RXLV_GETUNLIGHTY: procedure expose rxlv. viewline. 
  386. var = rxlv.oldvar
  387. return rxlv.csi||rxlv.oldrow'H'viewline.var
  388.  
  389.  
  390. RXLV_GETLIGHTY: procedure expose rxlv. viewline. 
  391. var = rxlv.var
  392. return rxlv.csi||rxlv.row'H'rxlv.hilite||viewline.var||rxlv.off
  393.  
  394.  
  395. RXLV_CLOSEWIN: procedure expose rxlv.
  396. if rxlv.opened? then do
  397.     call close(rxlv.win)
  398.     rxlv.opened? = 0
  399. end
  400. return 
  401.  
  402.  
  403. RXLV_INIT: procedure expose rxlv.
  404. /* Hardcoded minimum values */
  405. rxlv.width = max(100, rxlv.width)
  406. rxlv.height = max(50, rxlv.height)
  407.  
  408. /* ANSI stuff */
  409. rxlv.csi = '9b'x  ; rxlv.esc = '1b'x
  410. rxlv.help = '7e'x ; rxlv.del = '7f'x
  411. rxlv.nl = '0a'x   ; rxlv.cr = '0d'x
  412. rxlv.off = rxlv.csi||'0m' 
  413. rxlv.topleft = rxlv.csi'48'x 
  414. rxlv.cls = rxlv.csi'H'rxlv.csi'J'
  415. rxlv.hilite = rxlv.csi'43;32m'
  416. rxlv.nowordwrap = rxlv.csi||'3f376c'x
  417. rxlv.nocursor = rxlv.csi||'302070'x 
  418. rxlv.cursorup = '41'x  ; rxlv.cursordown = '42'x 
  419. rxlv.scursorup = '54'x ; rxlv.scursordown = '53'x
  420. rxlv.win = 'listwin'
  421.  
  422. /* GUI constants */
  423. guiheight = 7 ; guiwidth = 8
  424.  
  425. /* Font info */
  426. intui = showlist(l, 'intuition.library',, a)
  427. call forbid()
  428. rxlv.screen = next(intui, 56)               /* IntuitionBase->ActiveScreen */
  429. font = next(rxlv.screen, 136)               /* Screen->RastPort.Font */
  430. fonty = c2d(import(offset(font, 20), 2))    /* Font->YSize */
  431. fontx = c2d(import(offset(font, 24), 2))    /* Font->XSize */
  432. call permit()
  433.  
  434. /* Listview width */
  435. do while (rxlv.width - guiwidth) // fontx ~= 0 
  436.     rxlv.width = rxlv.width + 1 
  437. end
  438. rxlv.dispcols = ((rxlv.width - guiwidth) % fontx)
  439. rxlv.filler = copies(' ', rxlv.dispcols)
  440.  
  441. /* Listview height */
  442. const = guiheight + fonty
  443. do while (rxlv.height - const) // fonty ~= 0 
  444.     rxlv.height = rxlv.height + 1 
  445. end
  446. rxlv.disprows = (rxlv.height - const) % fonty
  447.  
  448. rxlv.opened? = 0
  449. return
  450.  
  451.  
  452. REPLACE: procedure
  453. parse arg src, old, new
  454.  
  455. olen = length(old)
  456.  
  457. do forever
  458.     m = pos(old, src)
  459.     if m = 0 then leave
  460.     
  461.     src = insert(new, delstr(src, m, olen), m - 1)
  462. end
  463. return src
  464.  
  465.  
  466. CHECKLF: procedure expose nl cr
  467. str = arg(1)
  468. if pos(nl, str) > 0 then str = replace(str, nl, '\n')
  469. if pos(cr, str) > 0 then str = replace(str, cr, '\r')
  470. return str
  471.  
  472.  
  473. ADDLF: procedure expose nl cr
  474. str = arg(1)
  475. if pos('\n', str) > 0 then str = replace(str, '\n', nl)
  476. if pos('\r', str) > 0 then str = replace(str, '\r', cr)
  477. return str
  478.